{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module API.Docs.Generate.TypeScript where

import API.Docs.Commands
import API.Docs.Events
import API.Docs.Generate
import API.Docs.Responses
import API.Docs.Syntax
import API.Docs.Syntax.Types
import API.Docs.Types
import API.TypeInfo
import Data.Char (toUpper)
import qualified Data.List.NonEmpty as L
import Data.Text (Text)
import qualified Data.Text as T

commandsCodeFile :: FilePath
commandsCodeFile = "./packages/simplex-chat-client/types/typescript/src/commands.ts"

responsesCodeFile :: FilePath
responsesCodeFile = "./packages/simplex-chat-client/types/typescript/src/responses.ts"

eventsCodeFile :: FilePath
eventsCodeFile = "./packages/simplex-chat-client/types/typescript/src/events.ts"

typesCodeFile :: FilePath
typesCodeFile = "./packages/simplex-chat-client/types/typescript/src/types.ts"

commandsCodeText :: Text
commandsCodeText =
  ("// API Commands\n// " <> autoGenerated <> "\n")
    <> "\nimport * as T from \"./types\"\n"
    <> "\nimport {CR} from \"./responses\"\n"
    <> foldMap commandCatCode chatCommandsDocs
  where
    commandCatCode CCCategory {categoryName, categoryDescr, commands} =
      (T.pack $ "\n// " <> categoryName <> "\n// " <> categoryDescr <> "\n")
        <> foldMap commandCode commands
      where
        commandCode CCDoc {commandType = ATUnionMember tag params, commandDescr, syntax, responses, network} =
          ("\n// " <> commandDescr <> "\n")
            <> ("// Network usage: " <> networkUsage network <> ".\n")
            <> ("export interface " <> T.pack constrName <> " {\n")
            <> fieldsCode "" "T." params
            <> "}\n\n"
            <> ("export namespace " <> T.pack constrName <> " {\n")
            <> ("  export type Response = " <> constrsCode "  " "CR" (("CR." <> ) . T.pack . fstToUpper . memberTag) (map responseType responses))
            <> (if syntax == "" then "" else funcCode APITypeDef {typeName' = constrName, typeDef = ATDRecord params} syntax)
            <> "}\n"
          where
            constrName = fstToUpper tag

responsesCodeText :: Text
responsesCodeText =
  ("// API Responses\n// " <> autoGenerated <> "\n")
    <> "\nimport * as T from \"./types\"\n"
    <> unionTypeCode "CR" "T." chatRespTypeDef chatRespConstrs ""
  where
    chatRespTypeDef = APITypeDef {typeName' = "ChatResponse", typeDef = ATDUnion chatRespConstrs}
    chatRespConstrs = L.fromList $ map responseType chatResponsesDocs

eventsCodeText :: Text
eventsCodeText =
  ("// API Events\n// " <> autoGenerated <> "\n")
    <> "\nimport * as T from \"./types\"\n"
    <> unionTypeCode "CEvt" "T." chatEventTypeDef chatEventConstrs ""
  where
    chatEventTypeDef = APITypeDef {typeName' = "ChatEvent", typeDef = ATDUnion chatEventConstrs}
    chatEventConstrs = L.fromList $ concatMap catEvents chatEventsDocs
    catEvents CECategory {mainEvents, otherEvents} = map eventType $ mainEvents ++ otherEvents

typesCodeText :: Text
typesCodeText = ("// API Types\n// " <> autoGenerated <> "\n") <> foldMap typeCode chatTypesDocs
  where
    typeCode CTDoc {typeDef = td@APITypeDef {typeName' = name, typeDef}, typeDescr, typeSyntax} =
      (if T.null typeDescr then "" else "// " <> typeDescr <> "\n")
        <> typeDefCode
        -- <> (if typeSyntax == "" then "" else syntaxText (name, self : typeFields) typeSyntax)
      where
        name' = T.pack name
        constrName tag = case name of
          "ConnectionMode" -> T.pack $ map toUpper tag
          "FileProtocol" -> T.pack $ map toUpper tag
          _ -> T.replace "-" "_" $ T.pack $ fstToUpper tag
        namespaceFuncCode = "\nexport namespace " <> name' <> " {" <> funcCode td typeSyntax <> "}\n"
        typeDefCode = case typeDef of
          ATDRecord fields ->
            ("\nexport interface " <> name' <> " {\n")
              <> fieldsCode "" "" fields
              <> "}\n"
              <> (if typeSyntax == "" then "" else namespaceFuncCode)
          ATDEnum cs ->
            ("\nexport enum " <> name' <> " {\n")
              <> foldMap (\m -> "  " <> constrName m <> " = \"" <> T.pack m <> "\",\n") cs
              <> "}\n"
              <> (if typeSyntax == "" then "" else namespaceFuncCode)
          ATDUnion cs -> unionTypeCode name' "" td cs typeSyntax

unionTypeCode :: Text -> String -> APITypeDef -> L.NonEmpty ATUnionMember -> Expr -> Text
unionTypeCode unionNamespace typesNamespace td@APITypeDef {typeName' = name} cs cmdSyntax =
  ("\nexport type " <> name' <> " = " <> constrsCode "" name' constrTypeRef (L.toList cs) <> "\n")
    <> ("export namespace " <> unionNamespace <> " {\n")
    <> ("  export type Tag = " <> constrsCode "  " name' constrTag (L.toList cs) <> "\n")
    <> ("  interface Interface {\n    type: Tag\n  }\n")
    <> foldMap constrType cs
    <> (if cmdSyntax == "" then "" else funcCode td cmdSyntax)
    <> "}\n"
  where
    name' = T.pack name
    constrTypeRef (ATUnionMember tag _) = unionNamespace <> "." <> constrName tag
    constrTag (ATUnionMember tag _) = T.pack $ "\"" <> tag <> "\""
    constrType c@(ATUnionMember tag fields) =
      ("\n  export interface " <> constrName tag <> " extends Interface {\n")
        <> "    type: " <> constrTag c <> "\n"
        <> fieldsCode "  " typesNamespace fields
        <> "  }\n"
    constrName tag = T.replace "-" "_" (T.pack $ fstToUpper tag)

constrsCode :: Text -> Text -> (ATUnionMember -> Text) -> [ATUnionMember] -> Text
constrsCode indent name' constr cs
  | T.length (name' <> " = " <> line) <= 100 = line <> "\n"
  | otherwise = "\n" <> foldMap (\c -> indent <> "  | " <> c <> "\n") cs'
  where
    line = T.intercalate " | " cs'
    cs' = map constr cs

funcCode :: APITypeDef -> Expr -> Text
funcCode td@APITypeDef {typeName' = name, typeDef} cmdSyntax =
  "\n  export function cmdString(" <> param <> ": " <> T.pack name <> "): string {\n    return " <> jsSyntaxText True (name, self : typeFields) cmdSyntax <> "\n  }\n"
  where
    param = if hasParams cmdSyntax then "self" else "_self"
    self = APIRecordField "self" (ATDef td)
    typeFields = case typeDef of
      ATDRecord fs -> fs
      ATDUnion ms -> APIRecordField "type" tagType : concatMap (\(ATUnionMember _ fs) -> fs) ms
        where
          tagType = ATDef $ APITypeDef (name <> ".type") $ ATDEnum tags
          tags = L.map (\(ATUnionMember tag _) -> tag) ms
      ATDEnum _ -> []

fieldsCode :: Text -> String -> [APIRecordField] -> Text
fieldsCode indent namespace = foldMap $ (indent <>) . T.pack . fieldText
  where
    fieldText (APIRecordField name t) = "  " <> name <> optional t <> ": " <> typeText t <> typeComment t <> "\n"
    optional = \case
      ATOptional _ -> "?"
      _ -> ""
    typeText = \case
      ATPrim (PT t) -> typeName t
      ATDef (APITypeDef t _) -> namespace <> t
      ATRef t -> namespace <> t
      ATOptional t -> typeText t
      ATArray {elemType} -> typeText elemType <> "[]"
      ATMap (PT t) valueType -> "{[key: " <> typeName t <> "]: " <> typeText valueType <> "}"
    typeName = \case
      TBool -> "boolean"
      TInt -> "number"
      TInt64 -> "number"
      TWord32 -> "number"
      TDouble -> "number"
      TJSONObject -> "object"
      TUTCTime -> "string"
      t -> t
    typeComment t = let c = typeComment' t in if null c then "" else " // " <> c
    typeComment' = \case
      ATPrim (PT t) -> typeComment_ t
      ATOptional (ATPrim (PT t)) -> typeComment_ t
      ATArray {elemType, nonEmpty}
        | nonEmpty -> (if null c then "" else c <> ", ") <> "non-empty"
        | otherwise -> c
        where
          c = typeComment' elemType
      ATMap (PT k) v ->
        let kc = typeComment_ k
            vc = typeComment' v
            tc t c = if null c then t else c
         in if null kc && null vc then "" else tc (typeName k) kc <> " : " <> tc (typeText v) vc
      _ -> ""
    typeComment_ = \case
      TInt -> "int"
      TInt64 -> "int64"
      TWord32 -> "word32"
      TDouble -> "double"
      TUTCTime -> "ISO-8601 timestamp"
      _ -> ""
